pacman::p_load(tidyverse, jsonlite,
tidygraph, ggraph, igraph, plotly, visNetwork,ggtext, ggiraph,patchwork, kableExtra, showtext)Take Home Exercise 2
1 Overview
For this take-home exercise, we will be working on Mini-Challenge 1 from the VAST Challenge 2025. The objective of this exercise is to design visual analytics methods to track the emergence of a rising artist and forecast the next potential breakout star.
We will address the questions from the mini-challenge specifically Question 3:
1.1 The Profile of Sailor Shift’s Career :
- Who has Sailor Shift been most influenced by over time?
- Who has she collaborated with and directly or indirectly influenced?
- How has she influenced collaborators within the broader Oceanus Folk community?
1.2 The Influence of Oceantus Folk to the Music World :
- Was this influence intermittent or did it show a gradual rise?
- What genres and top artists have been most influenced by Oceanus Folk?
- On the conveerse, how has Oceantus Folk changed the rise of Sailor Shift? From which genre does it draw most of its contemporary inspiration?
1.3 Profile of What it Means to be a Rising Star in the Music Industry
- Visualize the careers of 3 Artist
- Compare and Contrast their rise in Popularity and Influence
- Using this characterization, gives 3 Predictions of the next Oceanus Folk stars with be over the next 5 Years
2 The Data
We will use the dataset provided in the VAST Challenge 2025 Mini-Challenge 1.
| Attribute | Value |
|---|---|
| File Name | MC1_graph.json |
| Graph Type | Directed Multigraph |
| Number of Nodes | 17,412 |
| Number of Edges | 37,857 |
| Connected Components | 18 |
| Node_Type |
|---|
| Person |
| Song |
| RecordLabel |
| Album |
| MusicalGroup |
| Edge_Type | Description |
|---|---|
| PerformerOf | Source (Person or Group) performed the destination (Song or Album) |
| ComposerOf | Source (Person) composed the destination (Song or Album) |
| ProducerOf | Source (Person or Label) produced the destination’s work (Song, Album, Person, or Group) |
| LyricistOf | Source (Person) wrote lyrics for the destination (Song or Album) |
| RecordedBy | Destination (Label) recorded the source (Song or Album) |
| DistributedBy | Destination (Label) distributed the source (Song or Album) |
| InStyleOf | Source (Song/Album) is in the style of the destination (Song, Album, Person, or Group) |
| InterpolatesFrom | Source (Song/Album) interpolates melody from the destination (Song or Album) |
| CoverOf | Source (Song/Album) is a cover of the destination (Song or Album) |
| LyricalReferenceTo | Source (Song/Album) makes lyrical reference to the destination (Song or Album) |
| DirectlySamples | Source (Song/Album) directly samples audio from the destination (Song or Album) |
| MemberOf | Source (Person) is a member of the destination (MusicalGroup) |
3 Setting Up
3.1 Loading Packages
| Library | Description |
|---|---|
pacman |
A package management tool that simplifies the process of installing, loading, and managing R packages with a single function. Ideal for scripts requiring multiple libraries. |
tidyverse |
A cohesive collection of R packages for data science, including ggplot2, dplyr, tidyr, readr, and more—providing consistent grammar for data wrangling and visualization. |
jsonlite |
A fast and flexible JSON parser/serializer, useful for importing and exporting structured data such as API responses or configuration files. |
tidygraph |
A tidyverse-friendly package for network data manipulation and analysis, built on top of igraph. Enables graph operations using dplyr-like syntax. |
ggraph |
An extension of ggplot2 for visualizing graph/network data using layered grammar of graphics principles. Works seamlessly with tidygraph. |
igraph |
A powerful low-level package for network analysis and visualization, supporting complex graph structures, centrality metrics, and community detection. |
plotly |
Enables creation of interactive plots from ggplot2 or native plotly syntax. Useful for dashboards, exploratory data analysis, and web-based visualizations. |
visNetwork |
Creates rich, interactive network visualizations using vis.js. Highly customizable and ideal for interactive dashboards and exploratory analysis. |
ggtext |
Enhances ggplot2 by allowing Markdown/HTML formatting in axis labels, legends, titles, and more—perfect for expressive visual storytelling. |
ggiraph |
Adds interactivity (tooltips, hover effects, hyperlinks) to ggplot2 graphics. Useful for embedding interactive plots in Shiny apps or HTML reports. |
patchwork |
Simplifies the combination of multiple ggplot2 plots into a single layout using intuitive arithmetic-like syntax. Great for dashboards or multi-panel displays. |
kableExtra |
Extends knitr::kable() to create professional-looking tables in HTML, LaTeX, or Word with styling, column grouping, footnotes, and more. |
showtext |
Makes it easy to use custom fonts in R plots, including Chinese, Japanese, and Korean fonts—ideal for multilingual data visualization. |
3.2 Loading Data
data <- fromJSON("data/MC1_graph.json")
glimpse(data)List of 5
$ directed : logi TRUE
$ multigraph: logi TRUE
$ graph :List of 2
..$ node_default: Named list()
..$ edge_default: Named list()
$ nodes :'data.frame': 17412 obs. of 10 variables:
..$ Node Type : chr [1:17412] "Song" "Person" "Person" "Person" ...
..$ name : chr [1:17412] "Breaking These Chains" "Carlos Duffy" "Min Qin" "Xiuying Xie" ...
..$ single : logi [1:17412] TRUE NA NA NA NA FALSE ...
..$ release_date : chr [1:17412] "2017" NA NA NA ...
..$ genre : chr [1:17412] "Oceanus Folk" NA NA NA ...
..$ notable : logi [1:17412] TRUE NA NA NA NA TRUE ...
..$ id : int [1:17412] 0 1 2 3 4 5 6 7 8 9 ...
..$ written_date : chr [1:17412] NA NA NA NA ...
..$ stage_name : chr [1:17412] NA NA NA NA ...
..$ notoriety_date: chr [1:17412] NA NA NA NA ...
$ links :'data.frame': 37857 obs. of 4 variables:
..$ Edge Type: chr [1:37857] "InterpolatesFrom" "RecordedBy" "PerformerOf" "ComposerOf" ...
..$ source : int [1:37857] 0 0 1 1 2 2 3 5 5 5 ...
..$ target : int [1:37857] 1841 4 0 16180 0 16180 0 5088 14332 11677 ...
..$ key : int [1:37857] 0 0 0 0 0 0 0 0 0 0 ...
3.3 Custom Style
cl <- list(
bg = "#FEFCF3",
t_shirt = "#7B3F00",
sweater = "#D7A18F",
jeans = "#D9C6B0",
title = "#2F3A3F",
background = "#F8F1E5",
text = "#B1A293",
#Nodes
Person = "#D5D1E9",
MusicalGroup = "#D0E4EE",
RecordLabel = "#F3F5A9",
Song = "#F5CF9F",
Album = "#F28B82",
#Edges
PerformerOf = "#e6194b",
ComposerOf = "#f58231",
ProducerOf = "#ffe119",
LyricistOf = "#3cb44b",
RecordedBy = "#42d4f4",
DistributedBy = "#4363d8",
InStyleOf = "#911eb4",
InterpolatesFrom = "#f032e6",
CoverOf = "#fabebe",
LyricalReferenceTo = "#ffd8b1",
DirectlySamples = "#fffac8",
MemberOf = "#4A7365"
)font_add_google("Montserrat", "montserrat")
showtext_auto()
theme <- list(
font = 'montserrat',
size=14,
background = element_rect(fill = cl$bg,color = NA),
title = element_text(
size = 16,
face = "bold",
color = "black"),
fill = cl$text,
panel = element_rect(fill = cl$bg, color = NA),
grid = element_line(color = "#E6DCD0"),
#Text
caption = "Hover on the nodes to see more details.",
#Node
node_size = 7.5,
arrow_margin = 3.2,
arrow_style = arrow(type = "closed", length = unit(2, "pt")),
base_edge_thickness = 0.2,
tooltip = "background-color: #E6DCD0;
color: #2F3A3F;
border: 1px solid #e0d7ec;
border-radius: 6px;
padding: 6px;
font-size: 12px;
box-shadow: 1px 1px 4px rgba(0,0,0,0.1);
"
)4 Data Preparation
4.1 Extracting
edges <- as_tibble(data$links)
edge# A tibble: 12 × 2
Edge_Type Description
<chr> <chr>
1 PerformerOf Source (Person or Group) performed the destination (Song …
2 ComposerOf Source (Person) composed the destination (Song or Album)
3 ProducerOf Source (Person or Label) produced the destination's work …
4 LyricistOf Source (Person) wrote lyrics for the destination (Song or…
5 RecordedBy Destination (Label) recorded the source (Song or Album)
6 DistributedBy Destination (Label) distributed the source (Song or Album)
7 InStyleOf Source (Song/Album) is in the style of the destination (S…
8 InterpolatesFrom Source (Song/Album) interpolates melody from the destinat…
9 CoverOf Source (Song/Album) is a cover of the destination (Song o…
10 LyricalReferenceTo Source (Song/Album) makes lyrical reference to the destin…
11 DirectlySamples Source (Song/Album) directly samples audio from the desti…
12 MemberOf Source (Person) is a member of the destination (MusicalGr…
nodes <- as_tibble(data$nodes)
nodes# A tibble: 17,412 × 10
`Node Type` name single release_date genre notable id written_date
<chr> <chr> <lgl> <chr> <chr> <lgl> <int> <chr>
1 Song Breaking Th… TRUE 2017 Ocea… TRUE 0 <NA>
2 Person Carlos Duffy NA <NA> <NA> NA 1 <NA>
3 Person Min Qin NA <NA> <NA> NA 2 <NA>
4 Person Xiuying Xie NA <NA> <NA> NA 3 <NA>
5 RecordLabel Nautical Mi… NA <NA> <NA> NA 4 <NA>
6 Song Unshackled … FALSE 2026 Lo-F… TRUE 5 <NA>
7 Person Luke Payne NA <NA> <NA> NA 6 <NA>
8 Person Xiulan Zeng NA <NA> <NA> NA 7 <NA>
9 Person David Frank… NA <NA> <NA> NA 8 <NA>
10 RecordLabel Colline-Cas… NA <NA> <NA> NA 9 <NA>
# ℹ 17,402 more rows
# ℹ 2 more variables: stage_name <chr>, notoriety_date <chr>
colnames(nodes)[colnames(nodes) == "Node Type"] <- "type"
colnames(edges)[colnames(edges) == "Edge Type"] <- "relation"4.2 Check Missing Values
colSums(is.na(edges))relation source target key
0 0 0 0
colSums(is.na(nodes)) type name single release_date genre
0 0 13797 12801 12801
notable id written_date stage_name notoriety_date
12801 0 15957 16889 16763
4.3 Check for Duplicates
edges[duplicated(edges),]# A tibble: 0 × 4
# ℹ 4 variables: relation <chr>, source <int>, target <int>, key <int>
nodes[duplicated(nodes),]# A tibble: 0 × 10
# ℹ 10 variables: type <chr>, name <chr>, single <lgl>, release_date <chr>,
# genre <chr>, notable <lgl>, id <int>, written_date <chr>, stage_name <chr>,
# notoriety_date <chr>
5 Knowledge Graph
5.1 Mapping from node id to row index
id_map <- tibble(id = nodes$id,
index = seq_len(
nrow(nodes)))5.2 Map source and target IDs to row indices
edges <- edges %>%
left_join(id_map, by = c("source" = "id")) %>%
rename(from = index) %>%
left_join(id_map, by = c("target" = "id")) %>%
rename(to = index)5.3 Filtering out unmatched edges
edges <- edges %>%
filter(!is.na(from), !is.na(to))5.4 Plotting the Whole Graph
graph <- tbl_graph(nodes = nodes, edges = edges, directed = data$directed)
graph <- graph %>%
activate(nodes) %>%
mutate(`Node Type` = factor(type, levels = names(cl)))6 Exploratory Data Analysis
Code
ggplot(data = edges,
aes(y = relation)) +
geom_bar(fill = theme$fill) +
labs(title="Distribution of Edge Type") +
theme_classic() +
theme(plot.background = theme$background,
panel.background = theme$panel,
panel.grid.major = theme$grid,
text = element_text(family = theme$font,
size = theme$size),
plot.title = theme$title)
Code
ggplot(data = nodes,
aes(y = type)) +
geom_bar(fill = theme$fill) +
labs(title="Distribution of Node Type") +
theme_classic() +
theme(plot.background = theme$background,
panel.background = theme$panel,
panel.grid.major = theme$grid,
text = element_text(family = theme$font,
size = theme$size),
plot.title = theme$title)
6.1 Understanding the Most Connected Nodes
Code
graph %>%
activate(nodes) %>%
mutate(degree = centrality_degree()) %>%
as_tibble() %>%
arrange(desc(degree)) %>%
slice_head(n = 10) %>%
ggplot(aes(x = reorder(name, degree),
y = degree,
fill = `Node Type`)) +
geom_col() +
geom_text(aes(label = degree),
hjust = -0.2,
size = 4,
family = theme$font) +
coord_flip() +
labs(title = "Top 10 Most Connected Nodes", x = "Name", y = "Degree") +
scale_fill_manual(values = cl
) +
theme_classic() +
theme(
plot.background = theme$background,
panel.background = theme$panel,
panel.grid.major = theme$grid,
text = element_text(family = theme$font, size = theme$size),
plot.title = theme$title
)
Degree is a measure in network analysis that represents the number of direct connections a node has to other nodes.
Here I plot Top 10 Most Connected Nodes Plot to quickly see the key collaborators and influencers based on their direct connections within the community.
6.2 Top Genres
Code
nodes %>%
filter(!is.na(genre)) %>%
count(genre, sort = TRUE) %>%
slice_max(n, n = 10) %>%
ggplot(aes(x = reorder(genre, n), y = n, fill = n)) +
geom_col() +
scale_fill_gradient(low = cl$jeans, high = cl$text) +
coord_flip() +
labs(title = "Top 10 Genres", x = "Genre", y = "Count") +
theme_classic() +
theme(plot.background = theme$background,
panel.background = theme$panel,
panel.grid.major = theme$grid,
text = element_text(family = theme$font,
size = theme$size),
plot.title = theme$title)
Oceanus Folk is among the top genres which align with the narrative that Sailor Shift’s rise helped the Oceanus Folk genre into the mainstream music genres.
Dream Pop, Indie Folk, and Synthwave are the most represented genres in the dataset.
7 Plotting Sub-Graphs
In this part, I will create several subnetworks to explore different perspectives within the dataset.
Code
plot<- function(graph, center_name, title, size_1, size_2, show_arrows = TRUE, layout = "fr") {
set.seed(123)
V(graph)$type <- trimws(as.character(V(graph)$type))
E(graph)$relation <- trimws(as.character(E(graph)$relation))
V(graph)$name <- gsub("'", "`", V(graph)$name)
V(graph)$is_center <- V(graph)$name == center_name
V(graph)$tooltip <- paste0(
"Name: ", V(graph)$name, "\n",
"Type: ", V(graph)$type)
V(graph)$node_size <- degree(graph)
V(graph)$node_size <- scales::rescale(degree(graph), to = c(size_1, size_2))
node_colors <- cl[names(cl) %in% unique(V(graph)$type)]
edge_colors <- unlist(cl[names(cl) %in% unique(E(graph)$relation)])
edge_layer <- if (show_arrows) {
geom_edge_link(
aes(edge_colour = relation),
arrow = arrow(length = unit(1.5, "mm"), type = "closed"),
end_cap = circle(0.5, "mm"),
start_cap = circle(0.5, "mm"),
width = 0.3,
alpha = 0.7
)
} else {
geom_edge_link(
aes(edge_colour = relation),
end_cap = circle(0.5, "mm"),
start_cap = circle(0.5, "mm"),
width = 0.3,
alpha = 0.7
)
}
g<-ggraph(graph, layout = layout) +
edge_layer +
geom_edge_link(
aes(color = relation),
arrow = if (show_arrows) arrow(length = unit(1.5, "mm"), type = "closed") else NULL,
end_cap = circle(0.5, "mm"),
start_cap = circle(0.5, "mm"),
width = 0.3,
alpha = 0.7)+
geom_point_interactive(aes(
x = x, y = y,
fill = as.character(type),
tooltip = tooltip,
data_id = name,
size = node_size,
stroke = ifelse(is_center, 1, 0.15)
),
shape = 21
) +
scale_size_identity()+
geom_node_text(
aes(label = ifelse(is_center, name, "")),
nudge_y = 0.1,
nudge_x = -0.2,
repel = TRUE,
size = 3,
color = "black"
)+
theme_minimal() +
labs(title = title,
caption = "Hover to view details") +
scale_fill_manual(values = node_colors, name = "Node Type") +
scale_edge_colour_manual(values = edge_colors, name = "Edge Type") +
theme_minimal() +
theme(
panel.border = element_rect(color = "black", fill = NA, size = 0.5),
axis.title = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank(),
plot.background = element_rect(fill = "#FEFCF3", color = NA),
plot.title = element_text(color = cl$title, size = 14, face = "bold"),
plot.caption = element_text(hjust = 0, size = 8,face = "bold", margin = margin(t = 10),color = cl$title),
legend.text = element_text(size = 9),
legend.title = element_text(size = 10),
legend.key.size = unit(0.5, "lines"),
legend.spacing.y = unit(2, "pt")
)
girafe(ggobj = g,
options = list(opts_tooltip(css = theme$tooltip)))
}7.1 Functions
Ego
Code
ego_subgraph <- function(graph, center_name) {
graph %>%
activate(nodes) %>%
mutate(is_target = name == center_name) %>%
convert(to_subgraph, node_is_adjacent(which(is_target)) | is_target)
}Genre
Code
get_oceanusfolk_subgraph <- function(graph, genre_name = "Oceanus Folk", relation_type = "PerformerOf") {
oceanus_songs <- V(graph)[type == "Song" & genre == genre_name]
performer_edges <- E(graph)[relation == relation_type & .inc(oceanus_songs)]
connected_nodes <- unique(as.vector(ends(graph, performer_edges)))
temp_subgraph <- induced_subgraph(graph, V(graph)[name %in% connected_nodes])
subgraph.edges(temp_subgraph, E(temp_subgraph)[relation == relation_type])
}7.2 Sailor Shift Ego Network
Code
sailor_ego <- ego_subgraph(graph, "Sailor Shift")
plot(sailor_ego,"Sailor Shift","Ego Network of Sailor Shift",3,5)7.3 Oceanus Folk Sub Graph
Code
oceanusfolk_subgraph <- get_oceanusfolk_subgraph(graph)
plot(oceanusfolk_subgraph, center_name = "", title = "Oceanus Folk Songs",1,2,FALSE)8 Mini Challenge
8.1 Question 3 : Visualize the careers of three artists
To ensure genre-relevant comparisons, I limited my analysis to artists connected to the Oceanus Folk community through performer or stylistic influence links.
To have a data driven definition of a rising star within Oceanus Folk music industry, I begin by examining the career of Sailor Shift. Her rise in popularity provides a benchmark for identifying the key traits and network patterns that characterize emerging breakout artists in this genre.
To identify rising stars in the Oceanus Folk genre, I propose the following set of metrics based on network structure and artist activity:
8.1.1 Defining Key Metrics
| Trait | Measured By |
|---|---|
| Creative Activity | Songs & Album released over time |
| Creative Contribution | ComposerOf, LyricistOf, ProducerOf edges |
| Collaboration | Any other person who is connected to the same song(s) as the artist via a creative roles |
| Public Recognition | Number of notable releases over time |
8.1.2 Functions
Plot
Code
plot <- function(graph, center_name, title, size_1, size_2, show_arrows = TRUE, layout = "fr") {
set.seed(123)
V(graph)$type <- trimws(as.character(V(graph)$type))
V(graph)$name <- gsub("'", "`", V(graph)$name)
V(graph)$is_center <- V(graph)$name == center_name
V(graph)$tooltip <- paste0("Name: ", V(graph)$name, "\nYear: ", V(graph)$release_date)
V(graph)$node_size <- scales::rescale(degree(graph), to = c(size_1, size_2))
E(graph)$relation <- trimws(as.character(E(graph)$relation))
node_colors <- cl[names(cl) %in% unique(V(graph)$type)]
edge_colors <- unlist(cl[names(cl) %in% unique(E(graph)$relation)])
g <- ggraph(graph, layout = layout) +
geom_edge_link(
aes(edge_colour = relation),
arrow = if (show_arrows) arrow(length = unit(3, "mm"), type = "closed") else NULL,
end_cap = circle(0.5, "mm"),
start_cap = circle(0.5, "mm"),
width = 0.3,
alpha = 0.7
) +
scale_edge_colour_manual(values = edge_colors, name = "Edge Type") +
geom_point_interactive(
aes(
x = x, y = y,
fill = as.character(type),
tooltip = tooltip,
data_id = name,
size = node_size,
stroke = ifelse(is_center, 1, 0.15)
),
shape = 21
) +
scale_size_identity() +
geom_node_text(
aes(label = ifelse(is_center, name, "")),
nudge_y = 0.5,
nudge_x = 0.2,
repel = TRUE,
size = 4,
color = "black"
) +
labs(
title = title,
caption = "Hover to view node's details"
) +
scale_fill_manual(values = node_colors, name = "Node Type") +
theme_minimal() +
theme(
panel.border = element_rect(color = "black", fill = NA, size = 0.5),
axis.title = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank(),
plot.background = element_rect(fill = "#FEFCF3", color = NA),
plot.title = element_text(color = cl$title, size = 14, face = "bold"),
plot.caption = element_text(hjust = 0, size = 8, face = "bold",
margin = margin(t = 10), color = cl$title),
legend.text = element_text(size = 9),
legend.title = element_text(size = 10),
legend.key.size = unit(0.5, "lines"),
legend.spacing.y = unit(2, "pt")
)
girafe(
ggobj = g,
options = list(opts_tooltip(css = theme$tooltip))
)
}Clean Duplicates
Code
clean_duplicate_artist <- function(graph, artist_name) {
igraph <- as.igraph(graph)
node_ids <- which(V(igraph)$name == artist_name)
if (length(node_ids) > 1) {
main_node <- node_ids[1]
dup_nodes <- node_ids[-1]
for (dup in dup_nodes) {
inc_edges <- incident(igraph, dup, mode = "all")
for (e in inc_edges) {
ends_ids <- ends(igraph, e, names = FALSE)
from_id <- ends_ids[1]
to_id <- ends_ids[2]
if (from_id == dup) from_id <- main_node
if (to_id == dup) to_id <- main_node
if (from_id != to_id) {
edge_attrs <- edge.attributes(igraph, e)
igraph <- add_edges(igraph, c(from_id, to_id))
new_edge_id <- ecount(igraph)
for (attr_name in names(edge_attrs)) {
edge_attr(igraph, attr_name, index = new_edge_id) <- edge_attrs[[attr_name]]
}
}
}
}
igraph <- delete_vertices(igraph, dup_nodes)
}
return(as_tbl_graph(igraph))
}Creative Activity
Code
artist_creativity <- function(graph, artist_name) {
artist_index <- graph %>%
activate(nodes) %>%
mutate(index = row_number()) %>%
filter(name == artist_name) %>%
pull(index)
member_of_groups <- graph %>%
activate(edges) %>%
filter(from == artist_index, relation == "MemberOf") %>%
pull(to)
group_names <- character()
group_indices <- integer()
if (length(member_of_groups) > 0) {
group_names <- graph %>%
activate(nodes) %>%
mutate(index = row_number()) %>%
filter(index %in% member_of_groups) %>%
pull(name)
group_indices <- graph %>%
activate(nodes) %>%
mutate(index = row_number()) %>%
filter(name %in% group_names) %>%
pull(index)
}
performer_ids <- c(artist_index, group_indices)
performed_ids <- graph %>%
activate(edges) %>%
filter(relation == "PerformerOf", from %in% performer_ids) %>%
pull(to)
performed_works <- graph %>%
activate(nodes) %>%
mutate(index = row_number()) %>%
filter(index %in% performed_ids,
(type == "Song" & single == TRUE & !is.na(single)) | type == "Album") %>%
select(name, release_date, type, index) %>%
arrange(release_date) %>%
as_tibble()
subgraph_indices <- unique(c(artist_index, group_indices, performed_works$index))
subgraph <- induced_subgraph(graph, vids = subgraph_indices) %>%
as_tbl_graph() %>%
activate(edges) %>%
filter(relation %in% c("PerformerOf", "MemberOf")) %>%
activate(nodes) %>%
mutate(label = case_when(
type == "Song" ~ paste0(name, " (", release_date, ")"),
type == "Album" ~ paste0("[Album] ", name, " (", release_date, ")"),
TRUE ~ name
))
return(list(
graph = subgraph,
works = performed_works %>% select(name, type, release_date),
group = group_names
))
}Code
release_timeline <- function(song_years, artist_name = "Artist") {
release_counts <- song_years %>%
filter(type %in% c("Song", "Album")) %>%
mutate(release_year = as.integer(release_date)) %>%
count(release_year)
ggplot(release_counts, aes(x = release_year, y = n)) +
geom_line(color = cl$jeans, linewidth = 1.2) +
geom_point(color = cl$t_shirt, size = 2) +
labs(
title = paste0(artist_name, "'s Songs or Albums Release Timeline"),
x = "Year",
y = "Number of Releases"
) +
scale_x_continuous(breaks = seq(min(release_counts$release_year),
max(release_counts$release_year), by = 1)) +
scale_y_continuous(breaks = seq(0, max(release_counts$n), by = 1)) +
theme_classic() +
theme(
plot.background = theme$background,
panel.background = theme$panel,
panel.grid.major = theme$grid,
text = element_text(family = theme$font, size = theme$size),
plot.title = theme$title,
axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)
)
}Creative Contribution
Code
contribution_network <- function(graph, artist_name) {
artist_id <- graph %>%
activate(nodes) %>%
mutate(index = row_number()) %>%
filter(name == artist_name) %>%
pull(index)
creative_edges <- graph %>%
activate(edges) %>%
filter(from == artist_id, relation %in% c("ComposerOf", "LyricistOf", "ProducerOf")) %>%
as_tibble()
node_info <- graph %>%
activate(nodes) %>%
mutate(index = row_number()) %>%
as_tibble()
creative_edges <- creative_edges %>%
left_join(node_info %>% select(index, name, release_date, type) %>%
mutate(release_year = as.integer(release_date)),
by = c("to" = "index"))
song_ids <- creative_edges$to
subgraph_indices <- unique(c(artist_id, song_ids))
subgraph <- induced_subgraph(graph, vids = subgraph_indices) %>%
as_tbl_graph() %>%
activate(edges) %>%
filter(relation %in% c("ComposerOf", "LyricistOf", "ProducerOf")) %>%
activate(nodes) %>%
mutate(
label = paste0(name, " (", release_date, ")")
)
song_data <- creative_edges %>%
select(name, relation, release_date, release_year) %>%
arrange(release_date)
return(list(graph = subgraph, song_data = song_data))
}Artist Collaborators
Code
artist_collab_network <- function(graph, artist_name) {
collab_roles <- c("PerformerOf", "ComposerOf", "LyricistOf", "ProducerOf")
artist_index <- graph %>%
activate(nodes) %>%
mutate(index = row_number()) %>%
filter(name == artist_name) %>%
pull(index)
artist_songs <- graph %>%
activate(edges) %>%
filter(from == artist_index, relation %in% collab_roles) %>%
pull(to)
collab_edges <- graph %>%
activate(edges) %>%
filter(to %in% artist_songs, relation %in% collab_roles) %>%
filter(from != artist_index) %>%
as_tibble()
collab_node_ids <- unique(c(artist_index, collab_edges$from, collab_edges$to))
subgraph <- graph %>%
as.igraph() %>%
induced_subgraph(vids = collab_node_ids) %>%
as_tbl_graph() %>%
activate(edges) %>%
filter(relation %in% collab_roles) %>%
activate(nodes) %>%
mutate(label = case_when(
`Node Type` == "Song" ~ paste0(name, " (", release_date, ")"),
TRUE ~ name
))
return(subgraph)
}Public Recognition
Code
public_recognition_table <- function(graph, artist_name) {
artist_id <- graph %>%
activate(nodes) %>%
mutate(row_id = row_number()) %>%
filter(name == artist_name) %>%
pull(row_id)
group_ids <- graph %>%
activate(edges) %>%
filter(from == artist_id, relation == "MemberOf") %>%
pull(to)
performer_ids <- if (length(group_ids) > 0) c(artist_id, group_ids) else artist_id
performer_edges <- graph %>%
activate(edges) %>%
filter(from %in% performer_ids, relation == "PerformerOf") %>%
as_tibble() %>%
mutate(Performer = ifelse(from == artist_id, "Solo", "Group"))
node_df <- graph %>%
activate(nodes) %>%
as_tibble() %>%
mutate(row_id = row_number())
charted <- performer_edges %>%
left_join(node_df, by = c("to" = "row_id")) %>%
filter(type %in% c("Song", "Album"), notable == TRUE) %>%
filter(type != "Song" | single == TRUE) %>%
transmute(
Title = name,
Type = type,
Performer,
`Release Year` = release_date
)
solo <- charted %>%
filter(Performer == "Solo") %>%
bind_rows(tibble(
Title = "Total",
Type = "",
Performer = "",
`Release Year` = as.character(nrow(.))
))
group <- charted %>%
filter(Performer == "Group") %>%
bind_rows(tibble(
Title = "Total",
Type = "",
Performer = "",
`Release Year` = as.character(nrow(.))
))
return(list(Solo = solo, Group = group))
}Code
public_recognition_line <- function(graph, artist_name = "Sailor Shift") {
artist_id <- graph %>%
activate(nodes) %>% mutate(row_id = row_number()) %>% filter(name == artist_name) %>% pull(row_id)
group_ids <- graph %>% activate(edges) %>% filter(from == artist_id, relation == "MemberOf") %>% pull(to)
has_group <- length(group_ids) > 0
performer_ids <- if (has_group) c(artist_id, group_ids) else artist_id
performer_edges <- graph %>% activate(edges) %>%
filter(from %in% performer_ids, relation == "PerformerOf") %>%
as_tibble() %>%
mutate(Performer = ifelse(from == artist_id, "Solo", "Group"))
node_df <- graph %>% activate(nodes) %>% as_tibble() %>% mutate(row_id = row_number())
charted_releases <- performer_edges %>%
left_join(node_df, by = c("to" = "row_id")) %>%
filter(type %in% c("Song", "Album"), notable == TRUE) %>%
transmute(Title = name, Type = type, Performer, `Release Year` = as.integer(release_date), Single = single)
albums <- charted_releases %>% filter(Type == "Album")
singles <- charted_releases %>% filter(Type == "Song", Single == TRUE)
album_counts <- albums %>% count(`Release Year`, Performer, name = "Count") %>% mutate(Type = "Album")
single_counts <- singles %>% count(`Release Year`, Performer, name = "Count") %>% mutate(Type = "Song")
all_years <- min(c(album_counts$`Release Year`, single_counts$`Release Year`), na.rm = TRUE):max(c(album_counts$`Release Year`, single_counts$`Release Year`), na.rm = TRUE)
all_performers <- unique(charted_releases$Performer)
album_complete <- album_counts %>% complete(`Release Year` = all_years, Performer = all_performers, Type = "Album", fill = list(Count = 0))
single_complete <- single_counts %>% complete(`Release Year` = all_years, Performer = all_performers, Type = "Song", fill = list(Count = 0))
song_dots <- expand.grid(`Release Year` = all_years, Performer = all_performers, stringsAsFactors = FALSE) %>%
left_join(singles %>% count(`Release Year`, Performer, name = "Count"), by = c("Release Year", "Performer")) %>%
mutate(Count = replace_na(Count, 0), Type = "Song")
make_plot <- function(df, dots, performer_label, type_label) {
line_color <- ifelse(type_label == "Song", cl$jeans, cl$jeans)
dot_fill <- ifelse(performer_label == "Solo", cl$t_shirt, cl$t_shirt)
ggplot(df, aes(x = `Release Year`, y = Count)) +
geom_line(color = line_color, linewidth = 1, alpha = 0.5, linetype = "dashed") +
geom_point(data = dots, aes(x = `Release Year`, y = Count), color = "black", fill = dot_fill, shape = 21, size = 2, inherit.aes = FALSE) +
scale_y_continuous(limits = c(0, max(df$Count, na.rm = TRUE) + 1), expand = c(0, 0)) +
scale_x_continuous(breaks = all_years) +
labs(title = paste(performer_label, type_label), x = "Release Year", y = "Number of Releases") +
theme_classic() +
theme(
plot.background = theme$background,
panel.background = theme$panel,
panel.grid.major = theme$grid,
text = element_text(family = theme$font, size = theme$size),
plot.title = theme$title,
axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)
)
}
p1 <- make_plot(album_complete %>% filter(Performer == "Solo"), album_complete %>% filter(Performer == "Solo"), "Solo", "Album")
p2 <- make_plot(single_complete %>% filter(Performer == "Solo"), song_dots %>% filter(Performer == "Solo"), "Solo", "Song")
p3 <- make_plot(album_complete %>% filter(Performer == "Group"), album_complete %>% filter(Performer == "Group"), "Group", "Album")
p4 <- make_plot(single_complete %>% filter(Performer == "Group"), song_dots %>% filter(Performer == "Group"), "Group", "Song")
if (has_group) {
(p1 | p2) / (p3 | p4)
} else {
p1 | p2
}
}8.1.3 List of Oceanus Folk Artist
Code
oceanus_nodes <- graph %>%
activate(nodes) %>%
mutate(row_id = row_number()) %>%
filter(genre == "Oceanus Folk", `Node Type` %in% c("Song", "Album")) %>%
pull(row_id)
oceanus_performers <- graph %>%
activate(edges) %>%
filter(to %in% oceanus_nodes, relation == "PerformerOf") %>%
pull(from) %>%
unique()
graph_with_centrality <- graph %>%
activate(nodes) %>%
mutate(
degree_centrality = centrality_degree()
)
centrality_table <- graph_with_centrality %>%
activate(nodes) %>%
mutate(row_id = row_number()) %>%
filter(row_id %in% oceanus_performers, `Node Type` == "Person") %>%
as_tibble() %>%
select(name, `Node Type`, degree_centrality) %>%
arrange(desc(degree_centrality))
colnames(centrality_table) <- c("Artist", "Node Type", "Connections")
centrality_table %>%
kable(caption = "Artists Who Performed Oceanus Folk Songs or Albums")%>%
scroll_box(height = "400px")| Artist | Node Type | Connections |
|---|---|---|
| Sailor Shift | Person | 52 |
| Yang Wan | Person | 30 |
| Rüdiger Graf | Person | 18 |
| Filippo Pelli | Person | 18 |
| Min Lei | Person | 16 |
| Yong Dong | Person | 15 |
| Xiuying Huang | Person | 15 |
| Ping Zeng | Person | 14 |
| Zacharie Martins | Person | 14 |
| Beatrice Albright | Person | 14 |
| Daniel O'Connell | Person | 14 |
| Orla Seabloom | Person | 12 |
| Guiying Liao | Person | 11 |
| Theresa Rivera | Person | 11 |
| Vanessa Ramos | Person | 11 |
| Min Kong | Person | 10 |
| Xia Jia | Person | 10 |
| Guiying Cao | Person | 9 |
| Na Lai | Person | 9 |
| Chao Zeng | Person | 9 |
| Xiuying Fang | Person | 9 |
| Nicola Bernetti | Person | 9 |
| Vincentio Gentili | Person | 9 |
| Yong Wang | Person | 9 |
| Tao Jin | Person | 9 |
| Yan Zou | Person | 8 |
| Lei Jin | Person | 8 |
| Xiulan Yi | Person | 8 |
| Martino Michelangeli | Person | 8 |
| Isabella Farinelli | Person | 8 |
| Xia Cui | Person | 8 |
| Guglielmo Canetta | Person | 8 |
| Juan Gong | Person | 8 |
| Xia Zeng | Person | 8 |
| Genevieve Bell | Person | 8 |
| Jing Kang | Person | 7 |
| Yong Shen | Person | 7 |
| Yong Lai | Person | 7 |
| Juan Yu | Person | 7 |
| Monica Nelson | Person | 7 |
| Yoko Fujita | Person | 7 |
| Serena Lettiere | Person | 7 |
| Xiulan Wang | Person | 7 |
| Tao Yao | Person | 7 |
| Charles Vazquez | Person | 7 |
| Walter White | Person | 6 |
| Jie Fan | Person | 6 |
| Jie Cui | Person | 6 |
| Tao Lei | Person | 6 |
| Qiang Xie | Person | 6 |
| Alfred Thibault | Person | 6 |
| Xiuying Li | Person | 6 |
| Wei Cheng | Person | 6 |
| Yang Zhao | Person | 6 |
| Jing Jin | Person | 6 |
| Chao Zheng | Person | 6 |
| Jörg Niemeier | Person | 6 |
| Maya Jensen | Person | 6 |
| Tao Cui | Person | 5 |
| Ping Sun | Person | 5 |
| Chao Tan | Person | 5 |
| Na Peng | Person | 5 |
| Wei Gao | Person | 5 |
| Stephen Meyer | Person | 5 |
| Yang Yao | Person | 5 |
| Aneta Pruschke-Sölzer | Person | 5 |
| Constance Guibert | Person | 5 |
| Yan Yan | Person | 5 |
| Zoé-Agnès Delaunay | Person | 5 |
| Ping Peng | Person | 5 |
| Lisa Hofmann | Person | 5 |
| Yan Zhou | Person | 5 |
| Xia Zhu | Person | 5 |
| Ming Jia | Person | 5 |
| Jie Su | Person | 5 |
| Bryan Smith | Person | 5 |
| Ronald Kennedy | Person | 5 |
| Frédéric de la Coulon | Person | 5 |
| Ming Xiao | Person | 5 |
| Na Dai | Person | 5 |
| Tao Dai | Person | 4 |
| Jeffrey Watson | Person | 4 |
| Qiang Song | Person | 4 |
| Xia Xia | Person | 4 |
| Min Jin | Person | 4 |
| Ignazio Pastine | Person | 4 |
| Fang Duan | Person | 4 |
| Chao Xiao | Person | 4 |
| Tao Lei | Person | 4 |
| Tao Du | Person | 4 |
| Christine Ward | Person | 4 |
| Mikayla Cook | Person | 4 |
| Na Wen | Person | 4 |
| Ming Zhong | Person | 4 |
| Valérie Mathieu | Person | 4 |
| Xia Wu | Person | 4 |
| Jing Zhang | Person | 4 |
| Yan Luo | Person | 4 |
| Michael Rivera | Person | 4 |
| Fang Wu | Person | 4 |
| Chad Marks | Person | 4 |
| Thomas Ball | Person | 4 |
| Kai Reynolds | Person | 4 |
| Gang Shao | Person | 3 |
| Xiulan Hao | Person | 3 |
| Guiying Ding | Person | 3 |
| Jun Wen | Person | 3 |
| Nadia van Dooren-de Jode Vastraedsd | Person | 3 |
| Coriolano Luria-Scialpi | Person | 3 |
| Lisa Martin | Person | 3 |
| Melissa Wheeler | Person | 3 |
| Xiulan Ye | Person | 3 |
| Xia Jia | Person | 3 |
| Donna Caldwell | Person | 3 |
| Min Gao | Person | 3 |
| Ping Liao | Person | 3 |
| Chao Sun | Person | 3 |
| Madeleine Pineau | Person | 3 |
| Laetitia Petitjean | Person | 3 |
| Jun Shao | Person | 3 |
| Wei Chang | Person | 3 |
| Na Ma | Person | 3 |
| Thibault Hardy | Person | 3 |
| Ping Wu | Person | 3 |
| Na Ren | Person | 3 |
| Victoria Higgins | Person | 3 |
| Donald Medina | Person | 3 |
| Joshua Orozco | Person | 3 |
| Qiang Qian | Person | 3 |
| Jeffery Bailey | Person | 3 |
| Lauretta Tresoldi | Person | 3 |
| Kimberly Stanton | Person | 3 |
| Jing Guo | Person | 3 |
| Patricia Pope | Person | 3 |
| Cesare Cicilia | Person | 3 |
| Jie Yan | Person | 3 |
| Adèle Bonneau | Person | 3 |
| Jun Hao | Person | 3 |
| Jun Han | Person | 3 |
| Xiulan Zhang | Person | 3 |
| Xiuying Mo | Person | 3 |
| Yong Tao | Person | 3 |
| Jun Xu | Person | 3 |
| Yang Zhang | Person | 3 |
| Yang Ma | Person | 3 |
| Ping Xu | Person | 3 |
| Xiulan Liang | Person | 3 |
| Alphons Donati-Pederiva | Person | 3 |
| Qiang Han | Person | 3 |
| Min Mo | Person | 3 |
| Jing Li | Person | 3 |
| Jie Zhong | Person | 3 |
| Jie Wang | Person | 3 |
| Xia Du | Person | 3 |
| Li Li | Person | 3 |
| Ryan Adams | Person | 3 |
| Min Huang | Person | 3 |
| Xiulan Zhong | Person | 3 |
| Jing Feng | Person | 3 |
| Carlos Duffy | Person | 2 |
| Min Qin | Person | 2 |
| Justin Morse | Person | 2 |
| Tara Kota | Person | 2 |
| Xiuying Liang | Person | 2 |
| Wei Liao | Person | 2 |
| Xiulan Lin | Person | 2 |
| Ming Yan | Person | 2 |
| Donna Ryan | Person | 2 |
| Xia Yan | Person | 2 |
| Jing Ding | Person | 2 |
| Juan Wen | Person | 2 |
| Wei Guo | Person | 2 |
| Xia Xiang | Person | 2 |
| Jing Zhong | Person | 2 |
| Juan Zeng | Person | 2 |
| Chao Wu | Person | 2 |
| Timothy Hansen | Person | 2 |
| Lei Zeng | Person | 2 |
| Na Ren | Person | 2 |
| David Morgan | Person | 2 |
| Mary Parsons | Person | 2 |
| Susan Da Silva | Person | 2 |
| Tao Ren | Person | 2 |
| Guiying Xia | Person | 2 |
| Yong Dai | Person | 2 |
| Qiang He | Person | 2 |
| Chao Tang | Person | 2 |
| Yui Kondo | Person | 2 |
| Qiang Song | Person | 2 |
| Chao Lu | Person | 2 |
| Ida Vigliotti | Person | 2 |
| Tao Yin | Person | 2 |
| Michael Snyder | Person | 2 |
| Fang Gu | Person | 2 |
| Tao Yao | Person | 2 |
| Ping Cui | Person | 2 |
| Tao Long | Person | 2 |
| Yang Zhong | Person | 2 |
| Jun Yu | Person | 2 |
| Lei Kong | Person | 2 |
| Yang Shao | Person | 2 |
| Xiulan Hu | Person | 2 |
| Michael Smith | Person | 2 |
| Li Wen | Person | 2 |
| Lei Tan | Person | 2 |
| Tao Hu | Person | 2 |
| Guiying Tao | Person | 2 |
| Chao Wu | Person | 2 |
| James Clark | Person | 2 |
| Lei Qian | Person | 2 |
| Courtney Phillips | Person | 2 |
| Wei Ma | Person | 2 |
| Gang Xiong | Person | 2 |
| Qiang Luo | Person | 2 |
| Min Song | Person | 2 |
| Jun Yuan | Person | 2 |
| Christine Jones | Person | 2 |
| Morgan Hernandez | Person | 2 |
| Ping Shao | Person | 2 |
| Tao Qin | Person | 2 |
| Xiulan Dong | Person | 2 |
| Xiuying Zhang | Person | 2 |
| Xiuying Deng | Person | 2 |
| Jennifer Alexander | Person | 2 |
| Latasha Watts | Person | 2 |
| Jie Chang | Person | 2 |
| Carly Luna | Person | 2 |
| Justin Berry | Person | 2 |
| Stephen Allen | Person | 2 |
| Chao Qiao | Person | 2 |
| Fang Xiang | Person | 2 |
| Michael Anderson | Person | 2 |
| Ricardo Ward | Person | 2 |
| Fang Zhou | Person | 2 |
| Xiulan Zhou | Person | 2 |
| Juan Duan | Person | 2 |
| Tao Qian | Person | 2 |
| Chao Kang | Person | 2 |
| Jun Ye | Person | 2 |
| Tomoya Nakamura | Person | 2 |
| Charles du Perez | Person | 2 |
| Feliciano Pizarro Moll | Person | 2 |
| Augusto Villaverde Armengol | Person | 2 |
| Jun Zou | Person | 2 |
| Jie Wan | Person | 2 |
| Margaretha Sager | Person | 2 |
| Guiying Pan | Person | 2 |
| Xiuying Duan | Person | 2 |
| Min Xia | Person | 2 |
| Jie Wu | Person | 2 |
| Isaiah Morales | Person | 2 |
| Guiying Tang | Person | 2 |
| Gang Shen | Person | 2 |
| Renata Manolesso | Person | 2 |
| Russell Bates | Person | 2 |
| Gang Yang | Person | 2 |
| Min Tian | Person | 2 |
| Tao Xu | Person | 2 |
| Jun Yi | Person | 2 |
| Ping Meng | Person | 2 |
| Guiying Zhong | Person | 2 |
| Qiang Yang | Person | 2 |
| Xia Zhao | Person | 2 |
| Qiang Jiang | Person | 2 |
| Tanya Garrett | Person | 2 |
| John Maldonado | Person | 2 |
| Michael Reyes | Person | 2 |
| Summer Bender | Person | 2 |
| Ann Holland | Person | 2 |
| Guiying Qin | Person | 2 |
| Lei Zheng | Person | 2 |
| Xia Wang | Person | 2 |
| Na Yi | Person | 2 |
| Qiang Zhu | Person | 2 |
| Paulo Oestrovsky | Person | 2 |
| Amber Ramsey | Person | 2 |
| Li Wan | Person | 2 |
| Lagan Bhalla | Person | 2 |
| Georgina Piñol-Guerra | Person | 2 |
| Juan Dong | Person | 2 |
| Jenna York | Person | 2 |
| Yuki Hashimoto | Person | 2 |
| Matthew Murphy | Person | 2 |
| Douglas Roberts | Person | 2 |
| Ming Zhou | Person | 2 |
| Min Ding | Person | 2 |
| Min Xiong | Person | 2 |
| Tara Deshmukh | Person | 2 |
| Yong Ding | Person | 2 |
| Jie Long | Person | 2 |
| Luce Loiseau | Person | 2 |
| Ming Wang | Person | 2 |
| Chao Zhou | Person | 2 |
| Yesenia Miller | Person | 2 |
| Xiuying Xie | Person | 1 |
| Ryan Devan | Person | 1 |
| Tiya Sani | Person | 1 |
| Kimaya Srinivasan | Person | 1 |
| Rhonda Brown | Person | 1 |
| Mary Medina | Person | 1 |
| Laura Gibbs | Person | 1 |
| Raymond Mccoy | Person | 1 |
| Brandy Reyes | Person | 1 |
| Gang Pan | Person | 1 |
| Chao Mo | Person | 1 |
| Ping Feng | Person | 1 |
| Li Deng | Person | 1 |
| Lei Tao | Person | 1 |
| Chao Wu | Person | 1 |
| Min Xue | Person | 1 |
| Min Yu | Person | 1 |
| Jing Xu | Person | 1 |
| Sonia Weeks | Person | 1 |
| Richard Frazier | Person | 1 |
| Gang Jiang | Person | 1 |
| Juan Pan | Person | 1 |
| Sandra Smith | Person | 1 |
| Christopher Smith | Person | 1 |
| Yong Chen | Person | 1 |
| Gang Lai | Person | 1 |
| Xiulan Lu | Person | 1 |
| Min Jin | Person | 1 |
| Wei Lai | Person | 1 |
| Ming Wan | Person | 1 |
| Qiang Lai | Person | 1 |
| Yong Tan | Person | 1 |
| Yan Tao | Person | 1 |
| Li Zou | Person | 1 |
| Gang Yin | Person | 1 |
| Gang Zhang | Person | 1 |
| Na Zou | Person | 1 |
| Kaori Kobayashi | Person | 1 |
| Juan Qiao | Person | 1 |
| Jun Jin | Person | 1 |
| Xiulan Ren | Person | 1 |
| Guiying Yang | Person | 1 |
| Ping Chang | Person | 1 |
| Margherita Giammusso | Person | 1 |
| Pina Garrone | Person | 1 |
| Yang Mo | Person | 1 |
| Ethan Sanchez | Person | 1 |
| Yan Fang | Person | 1 |
| Na Yang | Person | 1 |
| Raymond Martin | Person | 1 |
| Min Huang | Person | 1 |
| Jing Xiang | Person | 1 |
| Tao Zou | Person | 1 |
| Li Qiao | Person | 1 |
| Ping Tao | Person | 1 |
| Na Han | Person | 1 |
| Fang Zhong | Person | 1 |
| Nicole Thomas | Person | 1 |
| Gang Fan | Person | 1 |
| Ming Qiao | Person | 1 |
| Guiying Ye | Person | 1 |
| Xiuying Huang | Person | 1 |
| Jun Fu | Person | 1 |
| Fang Han | Person | 1 |
| Ming Su | Person | 1 |
| Kelli Turner | Person | 1 |
| Latasha Chavez | Person | 1 |
| Patrizio Antonello-Salvemini | Person | 1 |
| Na Qian | Person | 1 |
| Eric Bartlett | Person | 1 |
| Min Yan | Person | 1 |
| Lei Tan | Person | 1 |
| Min He | Person | 1 |
| Li Qiu | Person | 1 |
| Ping Yan | Person | 1 |
| Xia Kang | Person | 1 |
| Ming Yao | Person | 1 |
| Xia Xia | Person | 1 |
| Na Cai | Person | 1 |
| Li Huang | Person | 1 |
| Yong Ye | Person | 1 |
| Ming Chen | Person | 1 |
| Li Ding | Person | 1 |
| Qiang Du | Person | 1 |
| Deborah Norton | Person | 1 |
| Li Long | Person | 1 |
| Xiulan Xu | Person | 1 |
| Gang Fu | Person | 1 |
| Ming Du | Person | 1 |
| Min Zheng | Person | 1 |
| Jing Long | Person | 1 |
| Xiuying Xiang | Person | 1 |
| Lori Young | Person | 1 |
| Sean Riggs | Person | 1 |
| Gang Wang | Person | 1 |
| Evelyn Gordon | Person | 1 |
| Yan Hou | Person | 1 |
| Jacob Arnold | Person | 1 |
| Édouard-Rémy Clerc | Person | 1 |
| Li Gu | Person | 1 |
| Jie Cui | Person | 1 |
| Gang Tian | Person | 1 |
| Victoria Vazquez | Person | 1 |
| Juan Wang | Person | 1 |
| Jing Zhong | Person | 1 |
| Juan Wu | Person | 1 |
| Jessica Carney | Person | 1 |
| Christopher Reilly | Person | 1 |
| Monica Murphy | Person | 1 |
| Jing Wei | Person | 1 |
| Ann Anderson | Person | 1 |
| Xiuying Kang | Person | 1 |
| Karen Robinson | Person | 1 |
| Li Zhou | Person | 1 |
| Jun Wang | Person | 1 |
| Fenna Zwart | Person | 1 |
| Na Yang | Person | 1 |
| Kimberly Moore | Person | 1 |
| Xiulan Yi | Person | 1 |
| Chao Fang | Person | 1 |
| Tao Ye | Person | 1 |
| Yong Guo | Person | 1 |
| Jing Cui | Person | 1 |
| Lisa Pennington | Person | 1 |
| Xiuying Shao | Person | 1 |
| Daria Ceravolo | Person | 1 |
| Luciano Chindamo | Person | 1 |
| Min Liao | Person | 1 |
| Jie Bai | Person | 1 |
| Yan Huang | Person | 1 |
| Joseph Cole | Person | 1 |
| Rachel Ford | Person | 1 |
| Yang Qian | Person | 1 |
| Juan Deng | Person | 1 |
| Chiyo Suzuki | Person | 1 |
| Kaori Watanabe | Person | 1 |
| Jennifer Harris | Person | 1 |
| Pauline Guyot de la Maillet | Person | 1 |
| Adrien Weiss | Person | 1 |
| Qiang Mo | Person | 1 |
| Yan Wang | Person | 1 |
| Regina Davis | Person | 1 |
| Deborah Davis | Person | 1 |
| Amanda Ramos | Person | 1 |
| Leif Bien | Person | 1 |
| Elsbeth Löwer | Person | 1 |
| Alexej Klotz | Person | 1 |
| Ping Zheng | Person | 1 |
| Gang Meng | Person | 1 |
| Lei Xue | Person | 1 |
| Wei Qian | Person | 1 |
| Nicholas Porter | Person | 1 |
| Xiuying Jia | Person | 1 |
| Christine Turner | Person | 1 |
| Li Dai | Person | 1 |
| Yong Tang | Person | 1 |
| Tao Su | Person | 1 |
| Jun Yuan | Person | 1 |
| Xiulan Lai | Person | 1 |
| Lei Su | Person | 1 |
| Elena Nibali | Person | 1 |
| Jose Garrett | Person | 1 |
| David Nash | Person | 1 |
| Amber Smith | Person | 1 |
| Gang Zhu | Person | 1 |
| Shlok Cherian | Person | 1 |
| Xia Yu | Person | 1 |
| Xiulan Xu | Person | 1 |
| Xiulan Gu | Person | 1 |
| Lei Liao | Person | 1 |
| Jie Li | Person | 1 |
| Mary King | Person | 1 |
| Jie Xu | Person | 1 |
| Yan Chang | Person | 1 |
| Chao Cheng | Person | 1 |
| Na Ren | Person | 1 |
| Qiang Xie | Person | 1 |
| Mitchell Bryan | Person | 1 |
| Ming Qiu | Person | 1 |
| Yang Lei | Person | 1 |
| Fang Qiao | Person | 1 |
| Ming Yu | Person | 1 |
| Guiying Qiu | Person | 1 |
| Jason Vaughn | Person | 1 |
| Na Jin | Person | 1 |
| Paul-Louis Benard | Person | 1 |
| Yan Zhu | Person | 1 |
| Chao Xiao | Person | 1 |
| Ping Song | Person | 1 |
| Xiulan Mo | Person | 1 |
| Min Liang | Person | 1 |
| Na Li | Person | 1 |
| Xia Shao | Person | 1 |
| Kyle Lawrence | Person | 1 |
| Edward Little | Person | 1 |
| Guiying Ma | Person | 1 |
| Jonathan Morris | Person | 1 |
| Xiuying Wei | Person | 1 |
| Michael Jefferson | Person | 1 |
| Andrew Lee | Person | 1 |
| Michael Gregory | Person | 1 |
| Maurice Harrison | Person | 1 |
| Scott Burke | Person | 1 |
| Devin Chan | Person | 1 |
| Juan Gu | Person | 1 |
| Qiang Dai | Person | 1 |
| Xiulan He | Person | 1 |
| Tao Chang | Person | 1 |
| Mandy Hood | Person | 1 |
| Robert Villanueva | Person | 1 |
| Thomas Dudley | Person | 1 |
| Charles Hall | Person | 1 |
| James Mosley | Person | 1 |
| Adriana Figueroa | Person | 1 |
| Qiang Gao | Person | 1 |
| Fang Yan | Person | 1 |
| Jing Chang | Person | 1 |
| Li Dong | Person | 1 |
| Qiang Sun | Person | 1 |
| Tomoya Takahashi | Person | 1 |
| Taichi Sasaki | Person | 1 |
| Na Deng | Person | 1 |
| Xia Ye | Person | 1 |
| Chelsea Harris | Person | 1 |
| Chao Qiu | Person | 1 |
| Emily Jackson | Person | 1 |
| Jie Cheng | Person | 1 |
| Juan Kang | Person | 1 |
| Michaela Brooks | Person | 1 |
| Rachel Rios | Person | 1 |
| Tammie Johnson | Person | 1 |
| Xia Shen | Person | 1 |
| Gang Ding | Person | 1 |
| Ming Deng | Person | 1 |
| Wei Yao | Person | 1 |
| Min Guo | Person | 1 |
| Juan Xiang | Person | 1 |
| Juan Cao | Person | 1 |
| Yong Qiao | Person | 1 |
| Christophe-Émile Grégoire | Person | 1 |
| Georges Chrétien | Person | 1 |
| Ming Xiang | Person | 1 |
| Wei Chen | Person | 1 |
| Yong Tang | Person | 1 |
| Jie Xu | Person | 1 |
| Steven Goodman | Person | 1 |
| Lei Wan | Person | 1 |
| Li Zeng | Person | 1 |
| Guiying Dong | Person | 1 |
| Na Peng | Person | 1 |
| Na Jiang | Person | 1 |
| Isla Quinn | Person | 1 |
8.1.4 Sailor Shift
Network Graph
Code
result <- artist_creativity(graph,"Sailor Shift")
center <- c("Sailor Shift", result$group)
plot(
result$graph,
center_name = center,
title = paste0(center[1], ": Songs and Release Years"),
size_1 = 5,
size_2 = 8,
show_arrows = TRUE,
layout = "kk"
)Line Graph
Code
release_timeline(result$works,"Sailor Shift")
Network Graph
Code
result <- contribution_network(graph,"Sailor Shift")
center <- c("Sailor Shift")
plot(
result$graph,
center_name = center,
title = paste0("How many works ",center[1]," have contributed?"),
size_1 = 5,
size_2 = 8,
show_arrows = TRUE,
layout = "kk"
)Code
result <- artist_collab_network(graph, "Sailor Shift")
center <- c("Sailor Shift")
plot(
result,
center_name = center,
title = paste0(center[1], "'s Collaboration Network"),
size_1 = 5,
size_2 = 8,
show_arrows = TRUE,
layout = "kk"
)Code
collaborator_count <- result %>%
activate(nodes) %>%
as_tibble() %>%
filter(`Node Type` %in% c("Person", "MusicalGroup"), name != "Sailor Shift") %>%
count(`Node Type`)
collaborator_count %>%
kable(caption = "Number of Collaborators")| Node Type | n |
|---|---|
| Person | 40 |
| MusicalGroup | 8 |
Table
Code
tables <- public_recognition_table(graph, "Sailor Shift")
tables$Solo %>%
kable(caption = "Solo Charted Releases", align = "lccc")| Title | Type | Performer | Release Year |
|---|---|---|---|
| Tidal Pop Waves | Album | Solo | 2028 |
| Salty Dreams | Album | Solo | 2030 |
| The Current & The Chord | Album | Solo | 2032 |
| Coral Beats | Album | Solo | 2034 |
| Tides & Ballads | Album | Solo | 2036 |
| Oceanbound | Album | Solo | 2038 |
| Echoes of the Deep | Album | Solo | 2040 |
| Stormsong | Song | Solo | 2038 |
| Tidesworn Ballads | Album | Solo | 2031 |
| Submerged Sonatas | Album | Solo | 2031 |
| Seashell Serenade | Song | Solo | 2030 |
| Total | 11 |
Code
tables$Group %>%
kable(caption = "Group Charted Releases", align = "lccc")| Title | Type | Performer | Release Year |
|---|---|---|---|
| The Kelp Forest Canticles | Album | Group | 2024 |
| Luminescent Tides | Album | Group | 2025 |
| Shoreline Sonnets | Album | Group | 2026 |
| Salt-Kissed Rhymes | Song | Group | 2026 |
| Total | 4 |
Line Graph
Code
public_recognition_line(graph, "Sailor Shift")
8.1.5 Yang Wan
Network Graph
Code
result <- artist_creativity(wan, "Yang Wan")
center <- c("Yang Wan", result$group)
plot(
result$graph,
center_name = center,
title = paste0(center[1], ": Songs and Release Years"),
size_1 = 5,
size_2 = 8,
show_arrows = TRUE,
layout = "kk"
)Line Graph
release_timeline(result$works,"Yang Wan")
Network Graph
Code
result <- contribution_network(wan,"Yang Wan")
center <- c("Yang Wan")
plot(
result$graph,
center_name = center,
title = paste0("How many works ",center[1]," have contributed?"),
size_1 = 5,
size_2 = 8,
show_arrows = TRUE,
layout = "kk"
)Code
result <- artist_collab_network(wan, "Yang Wan")
center <- c("Yang Wan")
plot(
result,
center_name = center,
title = paste0(center[1], "'s Collaboration Network"),
size_1 = 5,
size_2 = 8,
show_arrows = TRUE,
layout = "kk"
)Code
collaborator_count <- result %>%
activate(nodes) %>%
as_tibble() %>%
filter(`Node Type` %in% c("Person", "MusicalGroup"), name != "Yang Wan") %>%
count(`Node Type`)
collaborator_count %>%
kable(caption = "Number of Collaborators")| Node Type | n |
|---|---|
| Person | 76 |
| MusicalGroup | 2 |
Table
Code
tables <- public_recognition_table(wan, "Yang Wan")
tables$Solo %>%
kable(caption = "Solo Charted Releases", align = "lccc")| Title | Type | Performer | Release Year |
|---|---|---|---|
| Silent Projectiles | Song | Solo | 2027 |
| Echoes of Naomi | Song | Solo | 2020 |
| Bananal’s Gentle Whispers | Song | Solo | 2020 |
| Tender Embrace | Song | Solo | 1994 |
| Rakkauden Varjossa (In the Shadow of Love) | Song | Solo | 2013 |
| Perfect Harmony | Song | Solo | 2003 |
| Urban Haze | Song | Solo | 2022 |
| Whispers in the Unknown | Song | Solo | 2026 |
| Moments Between Heartbeats | Song | Solo | 2023 |
| Whispers Between Rooms | Album | Solo | 2022 |
| Scales and Streetlights | Album | Solo | 2000 |
| Canonical Refrain | Song | Solo | 2015 |
| Ringtone Requiem | Song | Solo | 2013 |
| Echoes of Armenia’s Crown | Song | Solo | 2021 |
| Silent Steps of Summer’s Daughter | Album | Solo | 2001 |
| Total | 15 |
Code
tables$Group %>%
kable(caption = "Group Charted Releases", align = "lccc")| Title | Type | Performer | Release Year |
|---|---|---|---|
| Total | 0 |
Line Graph
Code
public_recognition_line(wan, "Yang Wan")
8.1.6 Rüdiger Graf
Network Graph
Code
result <- artist_creativity(graf, "Rüdiger Graf")
center <- c("Rüdiger Graf", result$group)
plot(
result$graph,
center_name = center,
title = paste0(center[1], ": Songs and Release Years"),
size_1 = 5,
size_2 = 8,
show_arrows = TRUE,
layout = "kk"
)Line Graph
release_timeline(result$works,"Rüdiger Graf")
Network Graph
Code
result <- contribution_network(graf,"Rüdiger Graf")
center <- c("Rüdiger Graf")
plot(
result$graph,
center_name = center,
title = paste0("How many works ",center[1]," have contributed?"),
size_1 = 5,
size_2 = 8,
show_arrows = TRUE,
layout = "kk"
)Code
result <- artist_collab_network(graf, "Rüdiger Graf")
center <- c("Rüdiger Graf")
plot(
result,
center_name = center,
title = paste0(center[1], "'s Collaboration Network"),
size_1 = 5,
size_2 = 8,
show_arrows = TRUE,
layout = "kk"
)Code
collaborator_count <- result %>%
activate(nodes) %>%
as_tibble() %>%
filter(`Node Type` %in% c("Person", "MusicalGroup"), name != "Rüdiger Graf") %>%
count(`Node Type`)
collaborator_count %>%
kable(caption = "Number of Collaborators")| Node Type | n |
|---|---|
| Person | 25 |
| MusicalGroup | 1 |
Table
Code
tables <- public_recognition_table(graf, "Rüdiger Graf")
tables$Solo %>%
kable(caption = "Solo Charted Releases", align = "lccc")| Title | Type | Performer | Release Year |
|---|---|---|---|
| Glasses Raised | Song | Solo | 2027 |
| Concrete Kingdom | Song | Solo | 2026 |
| Colorful Traditions | Song | Solo | 2026 |
| Artificial Intuition Node | Song | Solo | 2024 |
| Cosmic Cartography | Song | Solo | 2026 |
| Total | 5 |
Code
tables$Group %>%
kable(caption = "Group Charted Releases", align = "lccc")| Title | Type | Performer | Release Year |
|---|---|---|---|
| Total | 0 |
Line Graph
Code
public_recognition_line(graf, "Rüdiger Graf")
Creative Activity : Sailor Shift built a long, steady career from 2024 to 2040, consistently releasing music, Yang Wan had an early start in 1994, disappeared for years, then made several strong comebacks after 2010, Rüdiger Graf rose quickly between 2024 and 2026, peaking fast but dropping off just as quickly a brief flash of fame that didn’t last. These distinct career patterns reveal that rising stars in Oceanus Folk begin with consistent growth.
Creative Contribution: Sailor Shift maintained a steady presence as a focused lyricist, Yang Wan contributed across multiple creative roles composer, lyricist, and producer showing strong versatility, Rüdiger Graf took on a mix of roles early on but lacked sustained involvement. This kind of observations suggest that rising stars often emerge through either consistent specialization on the rolse or early multi role engagement.
Collaboration: Yang Wan has the largest network with 76 individuals and 2 groups, showing broad influence and strong community presence, Sailor Shift has 40 individual and 8 group collaborators, suggesting a balanced, stable network built over time, while Rüdiger Graf has 25 individuals and 1 group—more limited, but notable given the shorter career span. Artists with high collaborator counts—especially early in their careers—tend to gain more exposure, expand their influence, and accelerate their growth. Thus, emerging artists who are quickly building networks are strong candidates to watch as the next rising stars.
Public Recognition: Sailor Shift stands out with both solo and group charted releases, showing broad reach and influence, Yang Wan has a strong solo-only chart record that reflects resilience and longevity, while Rüdiger Graf shows early momentum through recent solo chart activity, this is a key signal of rising star potential characteristics.
8.2 Question 3: The Next Rising Star of Oceanus Folk
Code
nodes <- graph %>%
activate(nodes) %>%
mutate(row_id = row_number()) %>%
as_tibble()
edges <- graph %>%
activate(edges) %>%
as_tibble()
oceanus_nodes <- nodes %>%
filter(genre == "Oceanus Folk", `Node Type` %in% c("Song", "Album")) %>%
pull(row_id)
oceanus_performers <- edges %>%
filter(to %in% oceanus_nodes, relation == "PerformerOf") %>%
pull(from) %>% unique()
collabs <- edges %>%
filter(relation %in% c("ComposerOf", "LyricistOf", "ProducerOf"),
from %in% oceanus_performers) %>%
group_by(from) %>%
summarise(Collabs = n_distinct(to), Creative = n(), .groups = "drop")
release_info <- edges %>%
filter(from %in% oceanus_performers, relation == "PerformerOf", to %in% oceanus_nodes) %>%
left_join(nodes %>% select(row_id, release_date, notable), by = c("to" = "row_id")) %>%
mutate(release_year = as.integer(release_date)) %>%
filter(!is.na(release_year)) %>%
left_join(nodes %>% select(row_id, name, `Node Type`) %>%
rename(artist_id = row_id, artist_name = name),
by = c("from" = "artist_id")) %>%
filter(`Node Type` %in% c("Person", "MusicalGroup"))
current_year <- 2040
table <- release_info %>%
group_by(artist_name, from) %>%
summarise(
First = min(release_year, na.rm = TRUE),
Total = n(),
Active = n_distinct(release_year),
Charted = sum(notable == TRUE, na.rm = TRUE),
.groups = "drop"
) %>%
filter(First >= 2030, Total >= 3) %>%
left_join(collabs, by = "from") %>%
mutate(
Inactivity = (current_year - First + 1) - Active,
Collabs = replace_na(Collabs, 0),
Creative = replace_na(Creative, 0),
Freshness = exp(-Inactivity * 0.4),
ChartedRatio = Charted / Total,
Score = round(((Total * 1.0) + (ChartedRatio * 15) + (Collabs * 1.0) + (Creative * 1.2)) * Freshness, 2)
) %>%
arrange(desc(Score))
kable(table, col.names = c("Artist", "ID", "First Release", "Total Works", "Active Years",
"Charted", "Collabs", "Creative", "Inactivity", "Freshness",
"Charted Ratio", "Rising Star Score"))| Artist | ID | First Release | Total Works | Active Years | Charted | Collabs | Creative | Inactivity | Freshness | Charted Ratio | Rising Star Score |
|---|---|---|---|---|---|---|---|---|---|---|---|
| The Brine Choir | 17047 | 2034 | 7 | 3 | 4 | 1 | 1 | 4 | 0.2018965 | 0.5714286 | 3.59 |
| Selkie’s Hollow | 17121 | 2037 | 5 | 1 | 2 | 0 | 0 | 3 | 0.3011942 | 0.4000000 | 3.31 |
| Copper Canyon Ghosts | 17362 | 2034 | 7 | 2 | 7 | 0 | 0 | 5 | 0.1353353 | 1.0000000 | 2.98 |
| Beatrice Albright | 17350 | 2031 | 8 | 3 | 8 | 3 | 3 | 7 | 0.0608101 | 1.0000000 | 1.80 |
| Daniel O’Connell | 17356 | 2031 | 8 | 3 | 8 | 3 | 3 | 7 | 0.0608101 | 1.0000000 | 1.80 |
| Tidal Reverie | 16988 | 2033 | 5 | 2 | 2 | 0 | 0 | 6 | 0.0907180 | 0.4000000 | 1.00 |
Based on the computed metrics including total works, charted ratio, collaboration count, creative contributions, and a freshness score that penalizes inactivity the predicted rising stars in the Oceanus Folk genre are The Brine Choir, Selkie’s Hollow, and Copper Canyon.
What Makes a Rising Star:
The model goes beyond just popularity. It also looks at:
- Creative Activity: Regular releases, like Sailor Shift’s, suggest steady growth.
- Creative Contribution: Versatile creators like Yang Wan, or focused ones like Sailor Shift, both show strong artistic identity.
- Collaboration: Large, active networks—especially built early—are often signs of rising stars.
- Public Recognition: Charted songs help, but they aren’t everything. Sailor Shift, for example, may not have a perfect chart ratio, but her consistency and connections still make her stand out.
Rising Star Score :
The score combines multiple aspects of an artist’s career to highlight those with strong future potential.
- Total Works reflects how productive an artist has been.
- Charted Ratio emphasizes public recognition impact matters more than volume.
- Collaboration Count and Creative Contributions show how engaged and versatile an artist is behind the scenes.
- All of these are adjusted by Freshness, which penalizes long inactivity artists who started early but went quiet get lower scores.
Additional Notes:
- The current year is assumed to be 2040.
- We filter artists whose works have release years between 2030 and 2040, and only artists with at least 3 releases during this period are included.This filtering helps exclude inactive or minimally active artists.